home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / GRAPHICS.SWG / 0033_Display PCX Files.pas < prev    next >
Pascal/Delphi Source File  |  1993-11-02  |  3KB  |  133 lines
  1. {
  2. > I heard something in this echo about someone having Pascal source to view
  3. > .PCX Files and I would appreciate if they would re-post the source if it's
  4. > not too long or tell me where I can get it.  I am also looking For some
  5. > good COMM routines For Pascal, anyone have any or no where I can get some?
  6.  
  7. The routine I have will only work With 320x200x256c images.
  8.  
  9.         For all those Pascal Programmers who just want something simple
  10.         to display a 320x200x256 colour PCX File on the screen here it is.
  11.         This was a direct translation from the C source code of PCXVIEW
  12.         written by Lee Hamel (Patch), Avalanche coder.  I removed the
  13.         Inline assembly code so that you beginners can see what was going
  14.         on behind those routines.
  15.  
  16. Norman Yen - Infinite Dreams BBS - August 11, 1993
  17. }
  18.  
  19. Type
  20.   pcxheader_rec = Record
  21.     manufacturer   : Byte;
  22.     version        : Byte;
  23.     encoding       : Byte;
  24.     bits_per_pixel : Byte;
  25.     xmin, ymin     : Word;
  26.     xmax, ymax     : Word;
  27.     hres, vres     : Word;
  28.     palette        : Array [0..47] of Byte;
  29.     reserved       : Byte;
  30.     colour_planes  : Byte;
  31.     Bytes_per_line : Word;
  32.     palette_Type   : Word;
  33.     filler         : Array [0..57] of Byte;
  34.   end;
  35.  
  36. Var
  37.   header  : pcxheader_rec;
  38.   width,
  39.   depth   : Word;
  40.   Bytes   : Word;
  41.   palette : Array [0..767] of Byte;
  42.   f       : File;
  43.   c       : Byte;
  44.  
  45. Procedure Read_PCX_Line(vidoffset : Word);
  46. Var
  47.   c, run : Byte;
  48.   n      : Integer;
  49.   w      : Word;
  50. begin
  51.   n := 0;
  52.   While (n < Bytes) do
  53.   begin
  54.     blockread (f, c, 1);
  55.     { if it's a run of Bytes field }
  56.     if ((c and 192) = 192) then
  57.     begin
  58.       { and off the high bits }
  59.       run := c and 63;
  60.       { get the run Byte }
  61.       blockread (f, c, 1);
  62.       n := n + run;
  63.       For w := 0 to run - 1 do
  64.       begin
  65.         mem[$a000 : vidoffset] := c;
  66.         inc(vidoffset);
  67.       end;
  68.     end
  69.     else
  70.     begin
  71.       n := n + 1;
  72.       mem[$a000 : vidoffset] := c;
  73.       inc(vidoffset);
  74.     end;
  75.   end;
  76. end;
  77.  
  78. Procedure Unpack_PCX_File;
  79. Var
  80.   i : Integer;
  81. begin
  82.   For i := 0 to 767 do
  83.     palette[i] := palette[i] shr 2;
  84.   Asm
  85.     mov ax, 13h
  86.     int 10h
  87.     mov ax, 1012h
  88.     xor bx, bx
  89.     mov cx, 256
  90.     mov dx, offset palette
  91.     int 10h
  92.   end;
  93.   For i := 0 to depth - 1 do
  94.     Read_PCX_Line(i * 320);
  95.   Asm
  96.     xor ax, ax
  97.     int 16h
  98.     mov ax, 03h
  99.     int 10h
  100.   end;
  101. end;
  102.  
  103. begin
  104.   if (paramcount > 0) then
  105.   begin
  106.     assign(f, paramstr(1));
  107.     reset(f, 1);
  108.     blockread (f, header, sizeof(header));
  109.     if (header.manufacturer = 10) and (header.version = 5) and
  110.        (header.bits_per_pixel = 8) and (header.colour_planes = 1) then
  111.     begin
  112.       seek(f, Filesize(f) - 769);
  113.       blockread(f, c, 1);
  114.       if (c = 12) then
  115.       begin
  116.         blockread(f, palette, 768);
  117.         seek(f, 128);
  118.         width := header.xmax - header.xmin + 1;
  119.         depth := header.ymax - header.ymin + 1;
  120.         Bytes := header.Bytes_per_line;
  121.         Unpack_PCX_File;
  122.       end
  123.       else
  124.         Writeln('Error reading palette.');
  125.     end
  126.     else
  127.       Writeln('Not a 256 colour PCX File.');
  128.     close(f);
  129.   end
  130.   else
  131.     Writeln('No File name specified.');
  132. end.
  133.